﻿module BoardTool.FixIt

open System
open System.Collections.Generic

open BoardTool.Tool
open BoardTool.Commands
open BoardTool.Board
open BoardTool.DirTree

// Should be public to make members and attributes visible through reflection.
[<CommandOptions( 
    [| "SRCDIR"; "DESTDIR" |], 
    [| "-v"
       "-keepWater0"; "-keepExits"; "-keepBridgeElev"; "-v35"
       "-minCF"; "-minBridgeCF"; "-minBldgCF"; "-minFuelTankCF"
       "-fixCF"; "-newBridgeCF"; "-fixBldgElev"
    |] 
    )>]
type FixDirArgs =
    {
    [<PositionalOption( "SRCDIR", "source directory" )>]
    mutable SrcDir : string
    [<PositionalOption( "DESTDIR", "destination directory" )>]
    mutable DestDir : string
    [<FlagOption( "-v", "verbose report" )>]
    mutable Verbose : bool
    [<FlagOption( "-keepWater0", "preserve water of depth 0 (likely bug)" )>]
    mutable KeepWater0 : bool
    [<FlagOption( "-keepExits", "preserve exits for terrain types that shouldn't have them" )>]
    mutable KeepExits : bool
    [<FlagOption( "-keepBridgeElev", "preserve existing bridge_elev level even if bridge is underwater" )>]
    mutable KeepBridgeElev : bool
    [<FlagOption( "-v35", "use terrain types for megamek v35" )>]
    mutable Use35 : bool
    [<NamedOption( "-minBridgeCF", "NUM", "minimum CF for bridges (default: 1)" )>]
    mutable MinBridgeCF : int
    [<NamedOption( "-minBldgCF", "NUM", "minimum CF for buildings (default: 1)" )>]
    mutable MinBldgCF : int
    [<NamedOption( "-minFuelTankCF", "NUM", "minimum CF for fuel tanks (default: 1)" )>]
    mutable MinFuelTankCF : int
    [<NamedOption( "-newBridgeCF", "NUM", "new bridge CF for underwater road (default: 40)" )>]
    mutable NewBridgeCF : int
    [<NamedOption( "-fixBldgElev", "NUM", "new bldg_elev value for buildings with negative elevations" )>]
    mutable FixBldgElev : int
    
    mutable FixCFValue : int option
    }
    with
        [<NamedOption( "-minCF", "NUM", "minimum CF for buildings, bridges, and fuel tanks (default: 1)" )>]
        member this.setMinCF( minCF : int ) =
            this.MinBldgCF <- minCF
            this.MinBridgeCF <- minCF
            this.MinFuelTankCF <- minCF

        [<NamedOption( "-fixCF", "NUM", "assign fixed CF to buildings, bridges, and fuel tanks below minimum" )>]
        member this.setFixCF( fixCF : int ) =
            this.FixCFValue <- Some fixCF

        member this.print( out : IO.TextWriter ) =
            fprintfn out "fixdir options:"
            fprintfn out "  SRCDIR: '%s'" this.SrcDir
            fprintfn out "  DESTDIR: '%s'" this.DestDir
            fprintfn out "  target megamek version: %s" (if this.Use35 then "0.35.x" else "0.34.10")
            fprintfn out "  minBridgeCF: %d" this.MinBridgeCF
            fprintfn out "  minBldgCF: %d" this.MinBldgCF
            fprintfn out "  minFuelTankCF: %d" this.MinFuelTankCF
            match this.FixCFValue with
            | Some value -> 
                fprintfn out "  fixCF: %d" value
            | None -> ()
            fprintfn out "  newBridgeCF: %d" this.NewBridgeCF
            let opts = 
                [this.KeepWater0, "keepWater0"; this.KeepExits, "keepExits"; this.KeepBridgeElev, "keepBridgeElev"]
                |> Seq.choose (fun (flag, str) -> if flag then Some str else None)
                |> String.concat " "
            if opts.Length > 0 then fprintfn out "  %s" <| opts
    
let private KNOWN_TERRAINS = 
    HashSet([
            "none"; "woods"; "water"; "rough"; "rubble"; 
            "jungle"; "sand"; "tundra"; "magma"; "planted_fields"; "heavy_industrial"; "space";
            "pavement"; "road"; "swamp"; "mud"; "rapids"; "ice"; "snow"; "fire"; "smoke"; "geyser";
            "building"; "bldg_cf"; "bldg_elev"; "bldg_basement"; "bldg_class"; "bldg_armor"; 
            "bridge"; "bridge_cf"; "bridge_elev"; 
            "fuel_tank"; "fuel_tank_cf"; "fuel_tank_elev"; "fuel_tank_magn";
            "impassable"; "elevator"; "fortified"; "screen";
            "fluff"; "arms"; "legs"; "metal_deposit"; "bldg_base_collapsed"
            ])

let private TERRAIN_TYPE_RANGES_35 =
    dict([
         "bldg_class", (1, 3)
         "woods", (1, 3)
         "rough", (1, 2)
         "fire", (1, 2)
         "smoke", (1, 4) // NB : SMOKE!
         "swamp", (1, 3)
         "geyser", (1, 3)
         "jungle", (1, 3)
         "magma", (1, 2)
         "rapids", (1, 2)
         "snow", (1, 2)
         "pavement", (1, 1)
         "impassable", (1, 1)
         "building", (1, 5)
         "fuel_tank", (1, 5)
         ])

let private TERRAIN_TYPE_RANGES_34 =
    dict([
         "bldg_class", (1, 3)
         "woods", (1, 3)
         "rough", (1, 2)
         "fire", (1, 2)
         "smoke", (1, 2) // NB : SMOKE!
         "swamp", (1, 3)
         "geyser", (1, 3)
         "jungle", (1, 3)
         "magma", (1, 2)
         "rapids", (1, 2)
         "snow", (1, 2)
         "pavement", (1, 1)
         "impassable", (1, 1)
         "building", (1, 5)
         "fuel_tank", (1, 5)
         ])

let private CAN_HAVE_EXITS = HashSet([ "road"; "fluff"; "fuel_tank"; "building"; "bridge"; "elevator" ])

let private canHaveExits tt =
    CAN_HAVE_EXITS.Contains( tt )

let private KNOWN_THEMES = HashSet([ ""; "grass"; "mars"; "lunar" ])

let private isKnownTerrainType ttype =
    KNOWN_TERRAINS.Contains( ttype )

let private BUILDING_SUBATTRS = ["bldg_elev"; "bldg_cf"; "bldg_class"; "bldg_basement"; "bldg_armor"]
let private FUEL_TANK_SUBATTRS = ["fuel_tank_cf"; "fuel_tank_elev"; "fuel_tank_magn"]
let private BRIDGE_SUBATTRS = ["bridge_cf"; "bridge_elev"]

type private IFixesObserver =
    abstract onFixedHex : Hex * string -> unit

let private clip min max i =
    if i < min then min
    elif i > max then max
    else i

    
type private FixDirCommand( ARGS : FixDirArgs ) =
    let TERRAIN_TYPE_RANGES = 
        if ARGS.Use35 then TERRAIN_TYPE_RANGES_35 else TERRAIN_TYPE_RANGES_34

    let killedThemes = HashSet()

    let fixTheme (fo : IFixesObserver) hex =
        let theme = hex.Theme
        if KNOWN_THEMES.Contains( theme ) then
            theme
        else
            if not <| killedThemes.Contains( theme ) then
                fo.onFixedHex( hex, sprintf "Removed unknown theme: %s" theme )
                killedThemes.Add( theme ) |> ignore
            ""        

    let fixTerrainsInHex (fo : IFixesObserver) (inHex : Hex) =
   
        let parseTerrains (hex : Hex) =
            let pt = TerrainTable( hex )
            for dup in pt.DuplicatesRemoved do
                fo.onFixedHex( inHex, 
                    sprintf "Removed duplicate terrain type: %s" dup )
            pt
        
        let fixTerrainLevelRange (ptt : TerrainTable) =
            for pt in ptt.TerrainEntries do
                if TERRAIN_TYPE_RANGES.ContainsKey( pt.Type ) then
                    let level = pt.Level
                    let (low, high) = TERRAIN_TYPE_RANGES.[pt.Type]
                    let level' = clip low high level
                    if level' <> level then
                        fo.onFixedHex( inHex, 
                            sprintf "Fixed terrain level for %s from %d to %d" pt.Type level level' )
                        pt.Level <- level'
            
        let fixTerrainExits (ptt : TerrainTable) =
            for pt in ptt.TerrainEntries do
                if not( canHaveExits pt.Type ) && Option.isSome pt.Exits then
                    fo.onFixedHex( inHex, 
                        sprintf "Removed unsupported exits for %s" pt.Type )
                    pt.Exits <- None
        
        let fixWaterDepth (ptt : TerrainTable) =
            if ptt.Contains( "water" ) then
                let pWater = ptt.["water"]
                if pWater.Level <= 0 then
                    let level' = 
                        if pWater.Level < 0 then 
                            - pWater.Level
                        elif pWater.Level = 0 && not( ARGS.KeepWater0 ) then 
                            1 
                        else 0
                    if level' <> pWater.Level then
                        fo.onFixedHex( inHex, 
                            sprintf "Fixed water depth from %d to %d" pWater.Level level' )
                        pWater.Level <- level'

        let fixCFs (ptt : TerrainTable) =
            let fixCF (tt : string) (minCF : int) =
                if ptt.Contains( tt ) then
                    let pt = ptt.[tt]
                    if pt.Level < minCF then
                        let level' = 
                            if Option.isSome ARGS.FixCFValue 
                            then Option.get ARGS.FixCFValue 
                            else minCF
                        fo.onFixedHex( inHex, 
                            sprintf "Fixed %s CF from %d to %d" tt pt.Level level' )
                        pt.Level <- level'

            fixCF "bldg_cf" ARGS.MinBldgCF
            fixCF "bridge_cf" ARGS.MinBridgeCF
            fixCF "fuel_tank_cf" ARGS.MinFuelTankCF
        
        let fixUnderwaterRoads (ptt : TerrainTable) =
            if ptt.Contains( "water" ) && ptt.Contains( "road" ) && not( ptt.Contains("bridge") )then
                let road = ptt.["road"]
                
                ptt.Remove( "road" )
                
                ptt.Add <| mkTerrain "bridge" 2 road.Exits
                ptt.Add <| mkTerrainWithLevel "bridge_cf" ARGS.NewBridgeCF
                ptt.Add <| mkTerrainWithLevel "bridge_elev" inHex.Elevation

                fo.onFixedHex( inHex, sprintf "Underwater road; added bridge, removed road" )

        let fixRequiredTerrain requireds forOthers (ptt : TerrainTable) =
            let othersContained = List.map (fun s -> s, ptt.Contains(s)) forOthers
            let hasAnyOf = List.exists snd othersContained
            if hasAnyOf then
                let hasAnyRequired = List.exists (fun s -> ptt.Contains(s)) requireds
                if not( hasAnyRequired ) then
                    let required = "[" + (String.concat "; " requireds) + "]"
                    for ttype, contained in othersContained do
                        if contained then
                            ptt.Remove( ttype )
                            fo.onFixedHex( inHex, sprintf "Removed %s: no %s" ttype required )
                        
        let fixBuilding (ptt : TerrainTable) =
            fixRequiredTerrain ["building"] BUILDING_SUBATTRS ptt

        let fixFuelTank (ptt : TerrainTable) =
            fixRequiredTerrain ["fuel_tank"] FUEL_TANK_SUBATTRS ptt

        let fixBridge (ptt : TerrainTable) =
            fixRequiredTerrain ["bridge"] BRIDGE_SUBATTRS ptt

        let fixBldgElev (ptt : TerrainTable) =
            if ptt.Contains( "bldg_elev" ) then
                let bldg_elev = ptt.["bldg_elev"]
                if bldg_elev.Level <= 0 then 
                    let level' = ARGS.FixBldgElev
                    fo.onFixedHex( inHex, sprintf "Fixed bldg_elev %d to %d" bldg_elev.Level level' )
                    ptt.["bldg_elev"] <- { bldg_elev with Level = level' }

        let fixBridgeElev (ptt : TerrainTable) =
            if ptt.Contains( "bridge_elev" ) then
                let bridge_elev = ptt.["bridge_elev"]
                if bridge_elev.Level < 0 then
                    fo.onFixedHex( inHex, sprintf "Fixed bridge_elev %d to %d" bridge_elev.Level 0 )
                    ptt.["bridge_elev"] <- { bridge_elev with Level = 0 }

        let work = parseTerrains inHex
            
        fixTerrainLevelRange work
        fixTerrainExits work
        fixWaterDepth work
        fixCFs work
        fixBuilding work
        fixFuelTank work
        fixBridge work
        fixUnderwaterRoads work
        fixBldgElev work
        fixBridgeElev work

        work.TerrainTypes |> Seq.map (fun tt -> work.[tt]) |> Seq.toList

    let fixFile srcFile destFile =
        let fixes = ResizeArray<string>()
        let fixesObserver =
            { new IFixesObserver with
                member this.onFixedHex( hex, fixDescr ) =
                    fixes.Add <| sprintf "{%s}: %s" (unparseHex hex) fixDescr
            }

        let fixTerrainsInHexFaster (inHex : Hex) =
            if List.isEmpty inHex.Terrains then inHex.Terrains
            else fixTerrainsInHex fixesObserver inHex

        let fixHex hex =
            { hex with 
                Terrains = fixTerrainsInHexFaster hex
                Theme = fixTheme fixesObserver hex
            }

        srcFile
        |> parseBoardFile
        |> Array.map (mapHex fixHex)
        |> unparseBoardFile destFile

        (srcFile, destFile, fixes)

    interface ICommand with
        member this.id = 
            sprintf "(fixdir %s %s)" ARGS.SrcDir ARGS.DestDir
        member this.run() =
            let logger = consoleLogger()
            ARGS.print( Console.Out )
            
            let res = transformBoards fixFile logger ARGS.SrcDir ARGS.DestDir
            
            let mutable totalFixes = 0
            let mutable maxFixes = 0
            let mutable worstFile = ""

            for (srcFile, destFile, fixes) in res.Values do
                if fixes.Count > 0 then
                    totalFixes <- totalFixes + fixes.Count
                    if maxFixes < fixes.Count then
                        maxFixes <- fixes.Count
                        worstFile <- srcFile
                    if ARGS.Verbose then
                        printfn ""
                        printfn "In file '%s' (from '%s'), %d fixes total:" srcFile destFile fixes.Count
                        fixes |> Seq.iter (printfn "  %s")                        
                    else
                        printfn "In file '%s' (from '%s'), %d fixes total" srcFile destFile fixes.Count

            printfn ""
            printfn "Total fixes: %d" totalFixes
            printfn "Most fixes in file '%s': %d" worstFile maxFixes
    
let FIX_DIR_COMMAND_FACTORY = 
    { new ReflectionCommandFactory< FixDirArgs >( "fixdir", "fixes known problems in boards" ) with
        override this.initArgs() =
            { 
            SrcDir = ""
            DestDir = ""
            Verbose = false
            KeepWater0 = false
            KeepExits = false
            KeepBridgeElev = false 
            Use35 = false
            MinBridgeCF = 1
            MinBldgCF = 1
            MinFuelTankCF = 1
            FixCFValue = None
            NewBridgeCF = 40
            FixBldgElev = 2
            }

        override this.createCommand( args ) =
            FixDirCommand( args ) :> ICommand    
    } :> ICommandFactory
